home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / PRUS101.ZIP / FVARCONV.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-12-19  |  6.3 KB  |  245 lines
  1. unit FVarConv; { FIDO unit for converting variables, bits 'n bytes stuff }
  2.  (***************************************************************************
  3.  
  4.             RELEASE 1.04 - as contained in the file PRUS100.LZH
  5.                 by Orazio Czerwenka, 2:2450/540.55, GERMANY
  6.  
  7.                --------------------------------------------
  8.                 organized for Fido's PASCAL related echoes    
  9.                --------------------------------------------
  10.  
  11.      05/14/1994 to 19/12/1994 by Orazio Czerwenka, 2:2450/540.55, GERMANY
  12.      19/12/1994 to --/--/---- by Matthias Tichy,   2:2440/210.14, GERMANY
  13.  
  14.            As far as third party copyrights are not violated this
  15.            source code is hereby placed to the public domain. Use
  16.            it whatever way you want, but use AT YOUR OWN RISK.
  17.  
  18.            In case you should modify the source rather send your
  19.            modifications to the unit's current organizer (see above for
  20.            NM address) than to spread it on your own. This will help to
  21.            keep the unit updated and grant a certain standard to all
  22.            other users as well.
  23.  
  24.            The unit is currently still under work. So it might greatly
  25.            benefit of your participation.
  26.  
  27.            Those who contributed to the following piece of source,
  28.            listed in alphabethical order:
  29.         ================================================================
  30.            Orazio Czerwenka, Stefan Frings, Jürgen Gehlen(BitsAreSet,
  31.            PCGo! 5/94), General Pascal FAQ as contained in SWAG,
  32.            Peter Schuette ...
  33.         ================================================================
  34.            YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.
  35.  
  36.            Credits in your own programs are as welcome as unnecessary.
  37.  
  38.  ***************************************************************************)
  39.  
  40. {$I FDEFINE.DEF}
  41.  
  42. interface
  43.  
  44.   function  BitIsSet(y,i:byte):Boolean;
  45.   function  BitsAreSet(y,i:byte):Boolean;
  46.   procedure SetBit(var y,i:byte);
  47.   procedure ResetBit(var y,i:byte);
  48.   procedure ToggleBit(var y,i:byte);
  49.  
  50.   function  BCD(b:byte):Byte;
  51.   function  UnBCD(b:byte):Byte;
  52.  
  53.   function  BooleToggle(toggle:Boolean):Boolean;
  54.  
  55.   function  NumStrValue(strName:string):Integer;
  56.  
  57.   function  LongInt2Str(l:LongInt):String;
  58.  
  59.   function  Dec2Bin(d:LongInt;n:Byte):String;
  60.   function  Dec2Hex(d:LongInt):String;
  61.   function  Dec2Oct(d:LongInt):String;
  62.  
  63.   function  DByte2Word(hi,lo:byte): Word;
  64.   procedure LongInt2DWord(l:LongInt; Var lower,upper:Word);
  65.   procedure DWord2LongInt(lower,upper: Word; Var l: LongInt);
  66.  
  67.   function  LinearAddr(p:pointer):LongInt;
  68.  
  69. implementation
  70.  
  71. type pt = Record       {type definition of a pointer}
  72.        ofs,seg:word;
  73.      End;
  74.  
  75. function BitIsSet(y,i:byte):Boolean;
  76. { Original author: General Pascal FAQ as contained in SWAG }
  77. begin
  78.   BitIsSet:= odd(y shr i);
  79. end;
  80.  
  81. function BitsAreSet(y,i:byte):Boolean;
  82. { Original author: Jürgen Gehlen (PCGo! 5/94) }
  83. begin {BitsAreSet}
  84.   asm
  85.     mov byte ptr @Result,0
  86.     mov al,y
  87.     mov ah,i
  88.     and al,ah
  89.     cmp al,i
  90.     jne @Bits1
  91.     mov al,1
  92.     inc byte ptr @Result
  93.     @Bits1:
  94.   end;
  95. end; {BitsAreSet}
  96.  
  97. procedure SetBit(var y,i:byte);
  98. { Original author: General Pascal FAQ as contained in SWAG }
  99. begin
  100.   y:= y or (1 shl i);
  101. end;
  102.  
  103. procedure ResetBit(var y,i:byte);
  104. { Original author: General Pascal FAQ as contained in SWAG }
  105. begin
  106.   y:= y and not(1 shl i);
  107. end;
  108.  
  109. procedure ToggleBit(var y,i:byte);
  110. { Original author: General Pascal FAQ as contained in SWAG }
  111. begin
  112.   y:= y xor (1 shl i);
  113. end;
  114.  
  115.  
  116. function BooleToggle(toggle:Boolean):Boolean;
  117. { Original author: Orazio Czerwenka }
  118. begin {BooleToggle}
  119.   Case toggle of
  120.     true : toggle:= false;
  121.     false: toggle:= true;
  122.   end;
  123.   BooleToggle:= toggle;
  124. end; {BooleToggle}
  125.  
  126. function NumStrValue (strName:string):Integer;
  127. { Original author: Orazio Czerwenka }
  128. var
  129.   l,
  130.   n : integer;
  131. begin {NumStrValue}
  132.   NumStrValue:= 0;
  133.   val(strName, l, n);
  134.   if n = 0 then NumStrValue:= l;
  135. end; {NumStrValue}
  136.  
  137. function LongInt2Str (l:LongInt):String;
  138. { Original author: Orazio Czerwenka }
  139. var
  140.   strName : string;
  141. begin {LongInt2Str}
  142.   str(l, strName);
  143.   LongInt2Str:= strName;
  144. end; {LongInt2Str}
  145.  
  146. function Dec2Bin(d:LongInt;n:Byte):String;
  147. { Original author: Peter Schuette }
  148. var bin : String;
  149.     s   : String[1];
  150.     i   : Byte;
  151. begin {Dec2Bin}
  152.   bin := '';
  153.   repeat
  154.     str(d MOD 2:1, s);
  155.     insert(s, bin, 1);
  156.     d:= d Div 2;
  157.   until d = 0;
  158.   {fill NUL from the right}
  159.   for i := 1 To n-length(bin)
  160.     do insert('0', bin, 1);
  161.   Dec2Bin := bin;
  162. end; {Dec2Bin}
  163.  
  164. function Dec2Hex(d:LongInt):String;
  165. { Original author: Peter Schuette }
  166. var hex : String;
  167.     s   : String[1];
  168.     i   : Byte;
  169. begin {Dec2Hex}
  170.   hex := '';
  171.   repeat
  172.     i := d MOD 16;
  173.     if i <= 9 then begin
  174.       str(i:1,s);
  175.       insert(s,hex,1);
  176.     end
  177.     else begin
  178.       s := chr(55+i);
  179.       insert(s,hex,1);
  180.     end;
  181.     d := d DIV 16;
  182.   until d = 0;
  183.   Dec2Hex :=  hex;
  184. end; {Dec2Hex}
  185.  
  186. function Dec2Oct(d:LongInt):String;
  187. { Original author: Peter Schuette }
  188. var oct : String;
  189.     s   : String[1];
  190.     i   : Byte;
  191. begin {Dec2Oct}
  192.   oct := '';
  193.   repeat
  194.     str(d MOD 8:1, s);
  195.     insert(s, oct, 1);
  196.     d := d DIV 8;
  197.   until d = 0;
  198.   Dec2Oct := oct;
  199. end; {Dec2Oct}
  200.  
  201. procedure LongInt2DWord(l:LongInt; Var lower,upper:Word);
  202. { Original author: Peter Schuette }
  203. begin {LongInt2DWord}
  204.   lower := word(l and $FFFF);
  205.   upper := word(l shr $10);
  206. end; {LongInt2DWord}
  207.  
  208. procedure DWord2LongInt(lower,upper: Word; Var l: LongInt);
  209. { Original author: Peter Schuette }
  210. var x: Record
  211.          Case Byte of
  212.            0: (full: LongInt);
  213.            1: (low,up: Word);
  214.          end;
  215. begin {DWord2LongInt}
  216.   x.up  := upper;
  217.   x.low := lower;
  218.   l := x.full;
  219. end; {DWord2LongInt}
  220.  
  221. function LinearAddr(p:pointer):LongInt;
  222. { Original author: Stefan Frings }
  223. begin
  224.   LinearAddr:=16*longint(pt(p).seg)+pt(p).ofs;
  225. end;
  226.  
  227. function DByte2Word(hi,lo:byte): Word;
  228. { Original author: Orazio Czerwenka }
  229. begin
  230.   DByte2Word:=hi SHL 8 +lo;
  231. end;
  232.  
  233. function BCD( B : Byte ) : Byte;
  234. { Original author: Max Maischein }
  235. begin
  236.   BCD := B div 10 shl 4 + ( B mod 10 );
  237. end;
  238.  
  239. function UnBCD( B : Byte ) : Byte;
  240. { Original author: Max Maischein }
  241. begin
  242.   UnBCD := B shr 4 * 10 + B mod 16;
  243. end;
  244.  
  245. end.